//	COPYRIGHT (C) 1981 BY BOARD OF TRUSTEES,
//	LELAND STANFORD JUNIOR UNIVERSITY

MANIFEST $( NUMTYPE = 1; STRTYPE = 2; LPARTYPE = 3; RPARTYPE = 4;
            EOLTYPE = 5; PSEOLTYPE = 6; QTYPE = 7; FNUMTYPE = 8;
            PSEUDOEOL = ';' $);
STATIC $( TYPESIZE = TABLE 0,2,2,1,1,1,1,1,3; TYPEDESCR = TABLE 0,
          "A NUMBER","A WORD","A LEFT PARENTHESIS","A RIGHT PARENTHESIS",
          "A CARRIAGE-RETURN","A SEMICOLON","A QUESTION MARK",
          "A FLOATING-POINT NUMBER" $);
STATIC $( STV = TABLE 1,STRTYPE; NTV = TABLE 1,NUMTYPE;
          NSTV = TABLE 2,NUMTYPE,STRTYPE; SLTV = TABLE 2,LPARTYPE,STRTYPE;
          SRTV = TABLE 2,RPARTYPE,STRTYPE $);
MANIFEST $( LPOSNMAX = 100; ITEMCHMAX = 79 $);
STATIC $( STRCAT = NIL; SCLEFT = NIL; STRSPAC = NIL; SSLEFT = NIL $);
STATIC $( LITEMS = VEC LPOSNMAX; LPOSN = 0; ISSUEDPROMPT = NIL $);

LET SPACEFULL(STR) BE
 $(
 OUTPUT:=TTY
 OUTS("SORRY, I'LL HAVE TO STOP; I'VE RUN OUT OF ");
 OUTS(STR);
 OUTS(" SPACE.*C*L");
 EXECUTERETURN()
 $);

LET SPACEALMOSTFULL(STR) BE
 $( STATIC $( OOUT1 = NIL $)
 OOUT1:=OUTPUT; OUTPUT:=TTY
 OUTS("NOTE:  I'M ALMOST OUT OF ");
 OUTS(STR);
 OUTS(" SPACE.*C*L")
 OUTPUT:=OOUT1
 $);

LET MAKESCAT(CAT,CATSZ,SPAC,SPACSZ) BE
 $(
 STRCAT:=CAT
 STRCAT!0:=0;
 SCLEFT:=CATSZ;
 STRSPAC:=SPAC;
 STRSPAC!0:=1;
 SSLEFT:=SPACSZ
 $);

LET NSWORDS(STR) = 1+[!STR>>29]/5;

LET NUMOFSTR(STR) = VALOF
 $( STATIC $( CATIX = NIL; I = NIL; NSW = NIL; FFREE = NIL $);
 STATIC $( SCWARN = FALSE; SSWARN = FALSE $);
 CATIX:=STRCAT!0;
 I:=0;
 WHILE I<CATIX DO $( I+:=1; IF STREQUAL(STR,STRCAT!I) DO RESULTIS I $)
 IF SCLEFT=0 DO RESULTIS SPACEFULL("STRING-CATALOG");
 NSW:=NSWORDS(STR);
 IF NSW>SSLEFT DO RESULTIS SPACEFULL("STRING");
 FFREE:=STRSPAC+STRSPAC!0;
 BLT(STR,FFREE,FFREE+NSW-1);
 STR:=FFREE;
 STRSPAC!0+:=NSW;
 SSLEFT-:=NSW
 CATIX+:=1;
 SCLEFT-:=1;
 STRCAT!CATIX:=STR;
 STRCAT!0:=CATIX;
 IF SCLEFT<10 DO
  UNLESS SCWARN DO
   $( SPACEALMOSTFULL("STRING-CATALOG"); SCWARN:=TRUE $);
 IF SSLEFT<10 DO
  UNLESS SSWARN DO
   $( SPACEALMOSTFULL("STRING-CATALOG"); SSWARN:=TRUE $);
 RESULTIS CATIX
 $);

LET STROFNUM(N) = ([0<N LE STRCAT!0] -> STRCAT!N,"");

LET OUTSNUM(STRNUM) BE OUTS(STROFNUM(STRNUM));

LET PUTITEM(ITEMTYPE,ITEM2,ITEM3,ITEM4,ITEM5,ITEM6) = VALOF
 $( STATIC $( LPT = NIL $);
 LPT:=LPOSN+TYPESIZE!ITEMTYPE;
 IF LPT>LPOSNMAX DO
  UNLESS ITEMTYPE=EOLTYPE DO
   $(
   OUTS("LINE TOO LONG; SOME INFORMATION WAS LOST AT THE END*C*L");
   WHILE INCH() NE '*L' DO;
   ITEMTYPE:=EOLTYPE;
   LPT:=LPOSN+1
   $);
 LPOSN:=LPT;
 SWITCHON TYPESIZE!ITEMTYPE INTO
  $(
  CASE 6: LPT-:=1; LITEMS!LPT:=ITEM6;
  CASE 5: LPT-:=1; LITEMS!LPT:=ITEM5;
  CASE 4: LPT-:=1; LITEMS!LPT:=ITEM4;
  CASE 3: LPT-:=1; LITEMS!LPT:=ITEM3;
  CASE 2: LPT-:=1; LITEMS!LPT:=ITEM2;
  CASE 1: LPT-:=1; LITEMS!LPT:=ITEMTYPE
  $);
 RESULTIS ITEMTYPE NE EOLTYPE
 $);

LET LINEIN(PROMPT) = VALOF
 $( STATIC $( NEXTCHAR = NIL; ITEMCOUNT = NIL $);

 LET GETCH() = VALOF
  $(
  NEXTCHAR:=INCH();
  IF 'a' LE NEXTCHAR LE 'z' DO NEXTCHAR+:=-'a'+'A';
  IF NEXTCHAR='*C' DO NEXTCHAR:=INCH();
  RESULTIS NEXTCHAR
  $);

 LET PACKNUMBER(V) = VALOF
  $( STATIC $( ANS = NIL; NDIGITS = NIL; SIGN = NIL $);
  SIGN:=1;
  NDIGITS:=!V;
  V+:=1;
  SWITCHON !V INTO
   $(
   CASE '-': SIGN:=-1;
   CASE '+': NDIGITS-:=1; V+:=1
   $);
  ANS:=!V;
  ANS:=(ANS='.' -> 0,ANS-'0');
  WHILE NDIGITS>1 DO
   $(
   NDIGITS-:=1;
   V+:=1;
   IF !V='.' DO LOOP;
   ANS:=ANS*10+!V-'0'
   $);
  RESULTIS SIGN*ANS
  $);

 LET DOTOFF(V) = VALOF
  $( STATIC $( POS = NIL $);
  POS:=V!0;
  WHILE V!POS NE '.' DO POS:=POS-1;
  RESULTIS V!0-POS
  $);

 LET ITEMREAD() = VALOF
  $( STATIC $( NUMFLAG = NIL; LINE = VEC ITEMCHMAX; STR = VEC [ITEMCHMAX+1]/5;
               CHCOUNT = NIL; COMMAFLAG = NIL; ANYDOT = NIL $);
  COMMAFLAG:=FALSE;
  ANYDOT:=FALSE;
  CHLP:
  SWITCHON NEXTCHAR INTO
   $(
   CASE ' ': GETCH(); GOTO CHLP;
   CASE ',': COMMAFLAG:=TRUE; GETCH(); GOTO CHLP;
   CASE '*L':
    TEST COMMAFLAG THEN $( OUTS("..."); COMMAFLAG:=FALSE; GETCH(); GOTO CHLP $)
    OR RESULTIS PUTITEM(EOLTYPE);
   CASE '(': GETCH(); RESULTIS PUTITEM(LPARTYPE);
   CASE ')': GETCH(); RESULTIS PUTITEM(RPARTYPE);
   CASE '?': GETCH(); RESULTIS PUTITEM(QTYPE);
   CASE PSEUDOEOL: GETCH(); RESULTIS PUTITEM(PSEOLTYPE);
   CASE '.': ANYDOT:=TRUE;
   CASE '-': CASE '+': CASE '0'...'9': NUMFLAG:=TRUE; ENDCASE;
   DEFAULT: NUMFLAG:=FALSE
   $);
  CHCOUNT:=0;
  CHLP2:
  TEST CHCOUNT<ITEMCHMAX THEN $( CHCOUNT+:=1; LINE!CHCOUNT:=NEXTCHAR $)
  OR
   IF CHCOUNT=ITEMCHMAX DO
    $(
    OUTS("ITEM TOO LONG; TRUNCATED TO ");
    FOR I=1 TO CHCOUNT DO OUTCH(LINE!I);
    NEWLINE(1);
    CHCOUNT+:=1
    $);
  SWITCHON GETCH() INTO
   $(
   CASE ',': CASE ' ': CASE '(': CASE ')': CASE '*L': CASE '?': CASE PSEUDOEOL:
    LINE!0:=(CHCOUNT>ITEMCHMAX -> ITEMCHMAX,CHCOUNT);
    TEST NUMFLAG BITAND [[CHCOUNT>1] BITOR ['0' LE LINE!1 LE '9']]
    THEN
     TEST ANYDOT THEN RESULTIS PUTITEM(FNUMTYPE,PACKNUMBER(LINE),DOTOFF(LINE))
     OR RESULTIS PUTITEM(NUMTYPE,PACKNUMBER(LINE))
    OR RESULTIS PUTITEM(STRTYPE,NUMOFSTR(PACKSTRING(LINE,STR)));
   CASE '.': TEST ANYDOT THEN NUMFLAG:=FALSE OR ANYDOT:=TRUE;
   CASE '0'...'9': GOTO CHLP2;
   DEFAULT: NUMFLAG:=FALSE; GOTO CHLP2
   $)
  $);

 OUTS(PROMPT);
 LPOSN:=1;
 ITEMCOUNT:=0;
 GETCH();
 ITEMCOUNT+:=1 REPEATWHILE ITEMREAD();
 LITEMS!0:=ITEMCOUNT;
 LPOSN:=1;
 RESULTIS LITEMS
 $);

LET NEXTIS(ITEMTYPE) = VALOF
 $(
 IF LPOSN=0 DO $( LPOSN:=1; LITEMS!1:=EOLTYPE $);
 RESULTIS LITEMS!LPOSN=ITEMTYPE
 $);

LET LINEOUT() BE
 $(

 LET FOUT(INTREP,POW10) BE
  $( STATIC $( FAC10 = NIL; P10 = NIL $);
  FAC10:=1;
  P10:=POW10;
  WHILE P10>0 DO $( P10:=P10-1; FAC10:=FAC10*10 $);
  IF INTREP<0 DO $( OUTCH('-'); INTREP:=-INTREP $);
  OUTNO(INTREP/FAC10);
  OUTCH('.');
  INTREP:=INTREP REM FAC10;
  POW10:=POW10-NCHARSN(INTREP);
  WHILE POW10>0 DO $( POW10:=POW10-1; OUTCH('0') $);
  OUTNO(INTREP)
  $);

 LET ITEMOUT(PREVSPACE,LPOSN) BE
  $(
  SWITCHON LITEMS!LPOSN INTO
   $(
   CASE EOLTYPE: NEWLINE(1); RETURN;
   CASE PSEOLTYPE: OUTCH(PSEUDOEOL); ITEMOUT(TRUE,LPOSN+1); RETURN;
   CASE RPARTYPE: OUTCH(')'); ITEMOUT(TRUE,LPOSN+1); RETURN;
   CASE LPARTYPE:
    IF PREVSPACE DO SPACES(1);
    OUTCH('(');
    ITEMOUT(FALSE,LPOSN+1);
    RETURN;
   CASE QTYPE:
    IF PREVSPACE DO SPACES(1);
    TEST LITEMS![LPOSN+1]=QTYPE THEN
     $(
     OUTS("??");
     WHILE LITEMS!LPOSN=QTYPE DO LPOSN+:=1;
     ITEMOUT(TRUE,LPOSN);
     RETURN
     $)
    OR $( OUTCH('?'); ITEMOUT(TRUE,LPOSN+1); RETURN $);
   CASE NUMTYPE:
    IF PREVSPACE DO SPACES(1);
    OUTNO(LITEMS![LPOSN+1]);
    ITEMOUT(TRUE,LPOSN+2);
    RETURN;
   CASE STRTYPE:
    IF PREVSPACE DO SPACES(1);
    OUTSNUM(LITEMS![LPOSN+1]);
    ITEMOUT(TRUE,LPOSN+2);
    RETURN;
   CASE FNUMTYPE:
    IF PREVSPACE DO SPACES(1);
    FOUT(LITEMS![LPOSN+1],LITEMS![LPOSN+2]);
    ITEMOUT(TRUE,LPOSN+3)
   $)
  $)

 ITEMOUT(FALSE,LPOSN)
 $);

LET LOPITEM() = VALOF
 $( STATIC $( TYPE = NIL $);
 ISSUEDPROMPT:=FALSE;
 TYPE:=LITEMS!LPOSN;
 LPOSN+:=TYPESIZE!TYPE;
 TEST TYPE=FNUMTYPE THEN
  RESULTIS FLOAT[LITEMS![LPOSN-2]]#/[10.0**[LITEMS![LPOSN-1]]]
 OR RESULTIS LITEMS![LPOSN-1]
 $);

LET FLUSHLINE() BE
 $( STATIC $( OLPOSN = NIL; TELLUSER = NIL $);
 IF NEXTIS(EOLTYPE) DO RETURN;
 TELLUSER:=NOT ISSUEDPROMPT;
 OLPOSN:=LPOSN;
 LOPITEM();
 UNLESS LITEMS!LPOSN=EOLTYPE DO TELLUSER:=TRUE;
 LPOSN:=OLPOSN;
 IF TELLUSER DO
  $(
  OUTS("ERASING ");
  UNLESS ISSUEDPROMPT DO OUTS("...");
  LINEOUT()
  $);
 LITEMS!LPOSN:=EOLTYPE
 $);

LET QRESPONSE(QSTR,QVEC,QQSTR) = VALOF
 $( STATIC $( DOUBQ = NIL $);
 TEST NEXTIS(QTYPE) THEN
  $(
  DOUBQ:=FALSE;
  LPOSN+:=1;
  IF NEXTIS(QTYPE) DO $( DOUBQ:=TRUE; WHILE NEXTIS(QTYPE) DO LPOSN+:=1 $);
  FLUSHLINE();
  TEST [DOUBQ BITAND [QQSTR NE 0]] THEN
   $(
   OUTS(QQSTR);
   NEWLINE(1)
   $)
  OR
   $(
   IF QSTR NE 0 DO $( OUTS(QSTR); NEWLINE(1) $);
   IF QVEC NE 0 DO FOR I=1 TO QVEC!0 DO $( OUTS(QVEC!I); NEWLINE(1) $)
   $)
  RESULTIS TRUE
  $)
 OR RESULTIS FALSE
 $);

LET CONDPROMPT(PROMPT,QSTR,QVEC,QQSTR,TYPEVEC) = VALOF
 $( STATIC $( TYPEOK = NIL; NTYPE = NIL; OKTYPE = NIL $);
 TRYPROMPT:
 ISSUEDPROMPT:=FALSE;
 IF NEXTIS(EOLTYPE) DO
  $(
  LINEIN(PROMPT);
  ISSUEDPROMPT:=TRUE;
  IF NEXTIS(EOLTYPE) DO RESULTIS FALSE
  $);
 IF NEXTIS(PSEOLTYPE) DO $( LPOSN+:=1; RESULTIS FALSE $);
 IF QRESPONSE(QSTR,QVEC,QQSTR) DO GOTO TRYPROMPT;
 TYPEOK:=FALSE;
 NTYPE:=TYPEVEC!0;
 WHILE NTYPE>0 DO
  $(
  OKTYPE:=TYPEVEC!NTYPE;
  NTYPE-:=1;
  IF NEXTIS(OKTYPE) DO $( TYPEOK:=TRUE; BREAK $)
  $);
 IF TYPEOK DO RESULTIS TRUE;
 OUTS("I WAS EXPECTING ");
 NTYPE:=TYPEVEC!0;
 WHILE NTYPE>0 DO
  $(
  OKTYPE:=TYPEVEC!NTYPE;
  NTYPE-:=1;
  OUTS(TYPEDESCR!OKTYPE);
  TEST NTYPE=0 THEN NEWLINE(1) OR OUTS(" OR ")
  $);
 FLUSHLINE();
 GOTO TRYPROMPT
 $);

LET STRCONTAIN(LILSTR,BIGSTR) = VALOF
 $( STATIC $( NCH = NIL; CHOFF = NIL $);
 NCH:=NCHARS(LILSTR);
 CHOFF:=29;
 WHILE NCH>0 DO
  $(
  NCH-:=1;
  CHOFF-:=7;
  IF CHOFF<0 DO $( LILSTR+:=1; BIGSTR+:=1; CHOFF:=29 $);
  IF [#177 BITAND[!LILSTR>>CHOFF]] NE
     [#177 BITAND[!BIGSTR>>CHOFF]] DO RESULTIS FALSE
  $);
 RESULTIS TRUE
 $);

LET YESNO(PROMPT,QQSTR,DEFLT) = VALOF
 $( STATIC $( RESPONSE = NIL $);
 TRYPROMPT:
 UNLESS CONDPROMPT(PROMPT,
                   (STRCONTAIN(DEFLT,"YES") -> "YES OR NO (DEFAULT IS YES)",
                                               "YES OR NO (DEFAULT IS NO)"),
                   0,QQSTR,STV) DO
  RESULTIS STRCONTAIN(DEFLT,"YES");
 RESPONSE:=STROFNUM(LITEMS![LPOSN+1]);
 LOPITEM();
 IF STRCONTAIN(RESPONSE,"YES") DO RESULTIS TRUE;
 IF STRCONTAIN(RESPONSE,"NO") DO RESULTIS FALSE;
 OUTS("I AM EXPECTING A YES OR NO ANSWER HERE*C*L");
 FLUSHLINE();
 GOTO TRYPROMPT
 $);

LET STRSELECT(STR,SELVEC) = VALOF
 $( STATIC $( NSEL = NIL; MATCHTAIL = NIL; NCSTR = NIL; AMBIG = NIL $);
 NCSTR:=NCHARS(STR);
 NSEL:=SELVEC!0;
 SELVEC+:=1;
 MATCHTAIL:=0;
 AMBIG:=FALSE;
 WHILE NSEL>0 DO
  $(
  NSEL-:=1;
  IF STRCONTAIN(STR,!SELVEC) DO
   TEST NCSTR=NCHARS(!SELVEC) THEN RESULTIS SELVEC!1
   OR
    TEST MATCHTAIL=0 THEN MATCHTAIL:=SELVEC
    OR AMBIG:=TRUE;
  SELVEC+:=2;
  $);
 IF AMBIG DO
  $(
  OUTS("I TAKE ");
  OUTS(STR);
  OUTS(" TO MEAN ");
  OUTS(!MATCHTAIL);
  NEWLINE(1);
  RESULTIS MATCHTAIL!1
  $);
 IF MATCHTAIL NE 0 DO RESULTIS MATCHTAIL!1;
 RESULTIS !SELVEC
 $);

LET PROMPTSELECT(PROMPT,QSTR,QVEC,QQSTR,POSSTRS,INSIST) = VALOF
 $( STATIC $( FAILVAL = NIL; SELVAL = NIL $);
 FAILVAL:=POSSTRS![1+2*[POSSTRS!0]];
 TRYPROMPT:
 UNLESS CONDPROMPT(PROMPT,QSTR,QVEC,QQSTR,STV) DO
   TEST INSIST THEN GOTO TRYPROMPT OR RESULTIS FAILVAL;
 SELVAL:=STRSELECT(STROFNUM(LITEMS![LPOSN+1]),POSSTRS)
 IF SELVAL=FAILVAL DO
  $(
  OUTSNUM(LITEMS![LPOSN+1]);
  OUTS(" IS NOT AN EXPECTED KEYWORD HERE*C*L");
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 LOPITEM();
 RESULTIS SELVAL
 $);

LET SWAPLITEMS() BE
 $( STATIC $( LITEMS2 = VEC LPOSNMAX; LPOSN2 = 0; TEM = NIL $);
 TEM:=LITEMS;
 LITEMS:=LITEMS2;
 LITEMS2:=TEM;
 TEM:=LPOSN;
 LPOSN:=LPOSN2;
 LPOSN2:=TEM
 $);

LET GETPOSINT(PROMPT,QQSTR,ANYOK) = VALOF
 $( STATIC $( POSINT = NIL; INT = "AN INTEGER GREATER THAN ZERO";
              AINT = "AN INTEGER GREATER THAN ZERO, OR THE WORD 'ANY'" $);
 TRYPROMPT:
 UNLESS CONDPROMPT(PROMPT,(ANYOK -> AINT,INT),0,QQSTR,(ANYOK -> NSTV,NTV)) DO
  RESULTIS -1;
 POSINT:=LITEMS![LPOSN+1];
 IF NEXTIS(STRTYPE) DO
  TEST STRCONTAIN(STROFNUM(POSINT),"ANY") THEN
   $( LOPITEM(); RESULTIS PLUSINF $)
  OR
   $(
   OUTSNUM(POSINT);
   OUTS(" ISN'T AN EXPECTED RESPONSE HERE*C*L");
   FLUSHLINE();
   GOTO TRYPROMPT
   $);
 IF POSINT>0 DO $( LOPITEM(); RESULTIS POSINT $);
 OUTS("THIS QUANTITY SHOULD BE GREATER THAN ZERO*C*L");
 FLUSHLINE();
 GOTO TRYPROMPT
 $);

LET GETNONNEGINT(PROMPT,QQSTR,ANYOK) = VALOF
 $( STATIC $( NONNEGINT = NIL; INT = "A NON-NEGATIVE INTEGER";
              AINT = "A NON-NEGATIVE INTEGER, OR THE WORD 'ANY'" $);
 TRYPROMPT:
 UNLESS CONDPROMPT(PROMPT,(ANYOK -> AINT,INT),0,QQSTR,(ANYOK -> NSTV,NTV)) DO
  RESULTIS -1;
 NONNEGINT:=LITEMS![LPOSN+1];
 IF NEXTIS(STRTYPE) DO
  TEST STRCONTAIN(STROFNUM(NONNEGINT),"ANY") THEN
   $( LOPITEM(); RESULTIS PLUSINF $)
  OR
   $(
   OUTSNUM(NONNEGINT);
   OUTS(" ISN'T AN EXPECTED RESPONSE HERE*C*L");
   FLUSHLINE();
   GOTO TRYPROMPT
   $);
 IF NONNEGINT GE 0 DO $( LOPITEM(); RESULTIS NONNEGINT $);
 OUTS("THIS QUANTITY SHOULD NOT BE NEGATIVE*C*L");
 FLUSHLINE();
 GOTO TRYPROMPT
 $);

LET BADNAME(RESERVEDNAMES,ERRSTR) = VALOF
 $( STATIC $( NAMESTR = NIL; NRES = NIL $);
 NAMESTR:=STROFNUM(LITEMS![LPOSN+1]);
 NRES:=RESERVEDNAMES!0+1;
 WHILE NRES>1 DO
  $(
  NRES-:=1;
  UNLESS STREQUAL(NAMESTR,RESERVEDNAMES!NRES) DO LOOP;
  OUTS(ERRSTR);
  NEWLINE(1);
  RESULTIS TRUE
  $);
 RESULTIS FALSE
 $);
